Population indicators
time_vec = seq(min(users$first_obs), max(users$last_obs), by = 1)
input_folder = paste0(IO$output_clue,"tracking/")
files = list.files(input_folder)
input_active_tracking = paste0(IO$tmp_clue,"active_tracking/")
tracking_pop_agg = foreach(file = files, .combine = rbind, .packages = c("dplyr","tidyverse")) %do% {
# tracking
tracking = read_feather(path = paste0(input_folder, file))
tracking$BC = dict$BC$type[match(tracking$birth_control_ud, dict$BC$birth_control)]
tracking = filter(tracking, BC %in% c("F","I"))
# variables aggregates
tracking_pop_agg = ddply(tracking,
.(date,country_area,BC),
summarise,
n_prot_sex = sum((category == "sex") & (type == "protected_sex"), na.rm = TRUE),
n_unprot_sex = sum((category == "sex") & (type == "unprotected_sex"), na.rm = TRUE),
n_wd_sex = sum((category == "sex") & (type == "withdrawal_sex"), na.rm = TRUE)
)
tracking_pop_agg = tracking_pop_agg %>% mutate(n_sex = n_prot_sex + n_unprot_sex + n_wd_sex)
# active tracking
active_tracking_compressed = read_feather(path = paste0(input_active_tracking,"active_",file))
active_tracking = expand_compressed_tracking(active_tracking_compressed)
active_tracking$BC = dict$BC$type[match(active_tracking$birth_control_ud, dict$BC$birth_control)]
active_tracking = filter(active_tracking, BC %in% c("F","I"))
# total number of users
active_tracking$country_area = tracking$country_area[match(active_tracking$user_id, tracking$user_id)]
active_tracking_agg = ddply(active_tracking,
.(date,country_area,BC),
summarise,
n_users = sum(tracking, na.rm = TRUE)
)
tmp = dplyr::full_join(x = active_tracking_agg , y = tracking_pop_agg, by = c("date","country_area","BC")) %>%
arrange(country_area, BC, date) %>%
replace_na(list(n_prot_sex = 0,n_unprot_sex = 0, n_wd_sex= 0, n_sex = 0))
return(tmp)
}
tmp = tracking_pop_agg %>% group_by(date, country_area, BC) %>%
summarise_each(.,sum) %>% arrange(country_area, BC, date)
tracking_pop_agg = tmp
indicators_folder = paste0(IO$output_clue, "pop_indicators/")
if(!dir.exists(indicators_folder)){dir.create(indicators_folder)}
write_feather(tracking_pop_agg, path = paste0(indicators_folder, "sex_pop_indicators.feather"))
ggplot(tracking_pop_agg, aes(x = date, y = n_users, col = BC))+
geom_line()+
facet_wrap(country_area ~ .)

ggplot(tracking_pop_agg, aes(x = date, y = n_sex/n_users, col = BC))+
geom_line()+
facet_wrap(country_area ~ .)

ggplot(tracking_pop_agg %>% filter(date > as.Date("2017-06-30")), aes(x = date, y = n_sex/n_users, col = BC))+
geom_line()+
facet_grid(country_area ~ BC)

ggplot(tracking_pop_agg %>% filter(date > as.Date("2017-06-30")), aes(x = date, y = n_prot_sex/n_users, col = BC))+
geom_line()+
facet_grid(country_area ~ BC)

ggplot(tracking_pop_agg %>% filter(date > as.Date("2017-06-30")), aes(x = date, y = n_unprot_sex/n_users, col = BC))+
geom_line()+
facet_grid(country_area ~ BC)

tracking_pop_agg = tracking_pop_agg %>% mutate(weekday = wday(date, week_start = 1),
month = month(date),
date_month = year(date)+(month-1)/12)
ggplot(tracking_pop_agg %>% filter(date > as.Date("2017-06-30")),
aes(x = factor(weekday), y = n_sex/n_users, col = BC))+
geom_violin(draw_quantiles = c(0.25,0.5,0.75))+
facet_grid(country_area ~ BC)
## Warning in regularize.values(x, y, ties, missing(ties)): collapsing to
## unique 'x' values
## Warning in regularize.values(x, y, ties, missing(ties)): collapsing to
## unique 'x' values
## Warning in regularize.values(x, y, ties, missing(ties)): collapsing to
## unique 'x' values

ggplot(tracking_pop_agg %>% filter(date > as.Date("2017-06-30")),
aes(x = factor(month), y = n_sex/n_users, col = BC))+
geom_violin(draw_quantiles = 0.5)+
facet_grid(country_area ~ BC)

ggplot(tracking_pop_agg %>% filter(date > as.Date("2017-06-30")),
aes(x = factor(date_month), y = n_sex/n_users, col = BC))+
geom_violin(draw_quantiles = 0.5)+
facet_grid(country_area ~ BC)

ggplot(tracking_pop_agg %>% filter(date > as.Date("2017-06-30")),
aes(x = date_month, y = n_sex/n_users, col = BC, fill = BC))+
stat_summary(geom="ribbon",
fun.ymin = function(x) quantile(x, 0.05),
fun.ymax = function(x) quantile(x, 0.95),
alpha = 0.3, col = NA) +
stat_summary(geom="ribbon",
fun.ymin = function(x) quantile(x, 0.25),
fun.ymax = function(x) quantile(x, 0.75),
alpha = 0.3, col = NA) +
stat_summary(geom = "line", fun.y=median) +
facet_grid(country_area ~ BC)

ggplot(tracking_pop_agg %>% filter(date > as.Date("2017-06-30")),
aes(x = date_month, y = n_sex/n_users, col = country_area))+
stat_summary(geom = "line", fun.y=median) +
facet_grid(. ~ BC)
